IF ~Arguments THEN dirm=UPPER(WORD(READLN(Prefs),3))
ELSE zzz=READLN(Prefs)
Sorting=UPPER(WORD(READLN(Prefs),3))
SaveOnError=UPPER(WORD(READLN(Prefs),3))
ProcOnErr=UPPER(WORD(READLN(Prefs),3))
ProcOnStr=SUBSTR(READLN(Prefs),19)
CharStripping=UPPER(WORD(READLN(Prefs),3))
PARSE VAR CharStripping CharMain "+" CharExtension
TDir=SUBSTR(READLN(Prefs),19)
IF RIGHT(TDir,1)~=':' & RIGHT(TDir,1)~='/' THEN TDir=TDir||'/'
IF ~Arguments THEN WildCard=WORD(READLN(Prefs),3)
ELSE zzz=READLN(Prefs)
ExamineFiles=UPPER(WORD(READLN(Prefs),3))
ExamineNames=UPPER(WORD(READLN(Prefs),3))
Shuffle=UPPER(WORD(READLN(Prefs),3))
zzz=READLN(Prefs)
zzz=READLN(Prefs)
CatBasis=WORD(READLN(Prefs),3)
CatForm=UPPER(WORD(READLN(Prefs),3))
AddSaver=UPPER(WORD(READLN(Prefs),3))
CatMode=UPPER(WORD(READLN(Prefs),3))
Mode=UPPER(WORD(READLN(Prefs),3))
SizeMode=UPPER(WORD(READLN(Prefs),3))
Cols=WORD(READLN(Prefs),3)
PWI=WORD(READLN(Prefs),3)
PHE=WORD(READLN(Prefs),3)
PHEBack=PHE
TWI=WORD(READLN(Prefs),3)
THI=WORD(READLN(Prefs),3)
TMode=WORD(READLN(Prefs),3)
BorderR=UPPER(WORD(READLN(Prefs),3))
BorderG=UPPER(WORD(READLN(Prefs),3))
BorderB=UPPER(WORD(READLN(Prefs),3))
MixFactor=UPPER(WORD(READLN(Prefs),3))
MixR=UPPER(WORD(READLN(Prefs),3))
MixG=UPPER(WORD(READLN(Prefs),3))
MixB=UPPER(WORD(READLN(Prefs),3))
Back1R=UPPER(WORD(READLN(Prefs),3))
Back1G=UPPER(WORD(READLN(Prefs),3))
Back1B=UPPER(WORD(READLN(Prefs),3))
Back2R=UPPER(WORD(READLN(Prefs),3))
Back2G=UPPER(WORD(READLN(Prefs),3))
Back2B=UPPER(WORD(READLN(Prefs),3))
Back3R=UPPER(WORD(READLN(Prefs),3))
Back3G=UPPER(WORD(READLN(Prefs),3))
Back3B=UPPER(WORD(READLN(Prefs),3))
Back4R=UPPER(WORD(READLN(Prefs),3))
Back4G=UPPER(WORD(READLN(Prefs),3))
Back4B=UPPER(WORD(READLN(Prefs),3))
Back2Pos=UPPER(WORD(READLN(Prefs),3))
BackDir=UPPER(WORD(READLN(Prefs),3))
zzz=READLN(Prefs)
zzz=READLN(Prefs)
MakeAlt=UPPER(WORD(READLN(Prefs),3))
Colors=WORD(READLN(Prefs),3)
SForm=UPPER(WORD(READLN(Prefs),3))
SMode=UPPER(WORD(READLN(Prefs),3))
Extension=WORD(READLN(Prefs),3)
zzz=CLOSE(Prefs)
END
ELSE DO
zzz=CLOSE(Prefs)
CALL SetDefs /* No File -> defaults */
END
MAIN:
TileList='"'||TMode||'" '||TileList /* Complete with TilingMode */
IF FSize>F2Size THEN FSizeMax=FSize
ELSE FSizeMax=F2Size
IF Sizing="BOTTOM" THEN FSizeMax=FSize+F2Size+2
IF ~Arguments THEN DO
IF Shuffle="YES" THEN ADPRO_TO_FRONT /* Screen2Front */
OKAY2 'Do you want to use the'||NL||' entire defaults?'||NL||'OK=Whole Cancel=Partial'
if rc=0 then useD=0
else useD=1
END
IF useD=0 THEN DO /* Ask for all the settings... */
/* Dirscanning or (Multi-)Select ? */
IF dirm="WHOLE" THEN DO
OKS="Manual"
OKS2="MULTI"
CANS="Whole"
CANS2="WHOLE"
END
ELSE DO
OKS="Whole"
OKS2="WHOLE"
CANS="Manual"
CANS2="MULTI"
END
OKAY2 '" Do you want to handle a'||NL||' whole directory?'||NL||'OK='||OKS||' Cancel='||CANS||'"'
if rc=0 then dirm=CANS2
else dirm=OKS2
/* Save-Format for catalogs */
IF Up2Date THEN DO
ListView '"Saver for Catalogs ?"' 10 ITEMS '"'||CatForm||'" '||SaverList
IF rc>1 THEN CALL ERR('')
PARSE VAR adpro_result '"' CatForm '"' . /* Get selected entry */
END
ELSE DO
GETSTRING '"Catalog SFORMAT-String ?"' CatForm
if rc~=0 then CALL ERR('')
CatForm=ADPro_Result
END
/* Check if the user actually may choose between RAW & IMAGE or not */
CatModeBak=CatMode
CatMode=''
IF INDEX('GIF',UPPER(CatForm))~=0 THEN CatMode='IMAGE'
IF INDEX('JPEG QRT RENDITION SCULPT',UPPER(CatForm))~=0 THEN CatMode='RAW'
/* If user may decide,then ask him now */
IF CatMode='' THEN DO
IF CatModeBak="RAW" THEN DO
OKS="IMAGE"
OKS2="IMAGE"
CANS="RAW"
CANS2="RAW"
END
ELSE DO
OKS="RAW "
OKS2="RAW"
CANS="IMAGE"
CANS2="IMAGE"
END
OKAY2 'What type of File is that type ?'||NL||'OK='||OKS||' or Cancel='||CANS
IF rc=0 THEN CatMode=CANS2
ELSE CatMode=OKS2
END
/* Scaling-Mode */
IF SizeMode="RELATIVE" THEN DO
OKS="Fit "
OKS2="ABSOLUTE"
CANS="Aspect"
CANS2="RELATIVE"
END
ELSE DO
OKS="Aspect"
OKS2="RELATIVE"
CANS="Fit"
CANS2="ABSOLUTE"
END
OKAY2 '" Shall the images be sized to'||NL||'fit each tile completely or to'||NL||' be sized aspect-correctly?'||NL||'OK='||OKS||' or Cancel='||CANS||'"'
IF rc=0 THEN SizeMode=CANS2
ELSE SizeMode=OKS2
/* Size of catalogs */
GETNUMBER '"Width of Catalogs ?"' PWI 20 9999
IF rc~=0 then CALL ERR('')
PWI=ADPro_Result
GETNUMBER '"Height of Catalogs ?"' PHE 20 9999
IF rc~=0 THEN CALL ERR('')
PHE=ADPro_Result
PHEBack=PHE
/* Color-Mode */
IF mode="COLOR" THEN DO
OKS="BW "
OKS2="BLACKWHITE"
CANS="Color"
CANS2="COLOR"
END
ELSE DO
OKS="Color"
OKS2="COLOR"
CANS="BW"
CANS2="BLACKWHITE"
END
OKAY2 'Make Color or Black&White'||NL||' Catalog-Picture?'||NL||'OK='||OKS||' Cancel='||CANS
IF rc=0 THEN mode=CANS2
ELSE mode=OKS2
/* If not truecolor,then ask now for number of colors/color-mode */
IF CatMode='IMAGE' THEN DO
IF Up2Date THEN DO
ListView '"Number of Colors"' 10 ITEMS '"'||Cols||'" '||ColorList
IF rc>1 THEN CALL ERR('')
PARSE VAR adpro_result '"' Cols '"' .
END
ELSE DO
GETSTRING "'How many Colors? (2-256,HAM8,CUST...)'" Cols
IF Wildcard~="OFF" & Wildcard~="*" & fl.0>0 & fl.0~="FL.0" THEN DO
FL0Back=fl.0
WCard=" "
WildBack=Wildcard
Wildcard=UPPER(Wildcard)
IF LEFT(Wildcard,1)="~" THEN DO
invert=1
Wildcard=SUBSTR(Wildcard,2)
END
ELSE invert=0
WMode=INDEX(Wildcard,"*")
IF WMode=0 THEN LEAVE
IF WMode=LENGTH(Wildcard) THEN WMode=0 /*WMode=0 ->right | WMode=1 ->left*/
WMode2=INDEX(Wildcard,"*",WMode+1)
IF WMode2~=0 THEN DO
IF WMode2=WMode+1 THEN Wildcard=SUBSTR(Wildcard,1,WMode)||SUBSTR(Wildcard,WMode+2)
ELSE DO
WModeBack=WMode
WMB2=WMode
WMode="-1" /* two '*' */
END
END
SELECT /* SetUp partial wildcards */
WHEN WMode="-1" THEN NOP
WHEN WMode=1 THEN WCard=SUBSTR(Wildcard,2)
WHEN WMode=0 THEN WCard=LEFT(Wildcard,LENGTH(Wildcard)-1)
OTHERWISE DO
WCard1=LEFT(Wildcard,WMode-1)
WCard2=SUBSTR(Wildcard,WMode+1)
END
END
DO i=1 TO fl.0
remove=invert
WLen=LENGTH(WCard) /* Some "constants" for speedup */
FLTry=UPPER(fl.i)
IF LEFT(FLTry,WLen)~=WCard THEN FLLeftTest=1
ELSE FLLeftTest=0
WCardB=SUBSTR(Wildcard,WMode2+1)
SELECT
WHEN WMode="-1" THEN DO /* double "*" */
Skip=WMode
WMode=WModeBack
WModeBack=Skip
Skip=0
IF WMode~=1 THEN DO
IF LEFT(FLTry,WMode-1)~=LEFT(Wildcard,WMode-1) THEN DO
remove=ABS(invert-1)
skip=1
END
END
IF ~skip THEN DO
IF INDEX(FLTry,SUBSTR(Wildcard,WMB2+1,WMode2-WMB2-1))=0 THEN DO
remove=ABS(invert-1)
skip=1
END
END
IF WMode2~=LENGTH(Wildcard) & ~skip THEN DO
IF RIGHT(FLTry,LENGTH(WCardB))~=WCardB THEN DO
remove=ABS(invert-1)
END
END
Skip=WMode
WMode=WModeBack
WModeBack=Skip
END
WHEN WMode=1 THEN DO /* "*" on first char */
IF RIGHT(FLTry,WLen)~=WCard THEN remove=ABS(invert-1)
END
WHEN WMode=0 THEN DO /* "*" on last char */
IF FLLeftTest THEN remove=ABS(invert-1)
END
OTHERWISE DO /* "*" anywhere */
IF RIGHT(FLTry,LENGTH(WCard2)))~=WCard | FLLeftTest THEN remove=ABS(invert-1)
END
END
IF remove THEN DO /* Remove entry */
IF fl.0>i THEN DO
DO j=i TO fl.0-1
k=j+1
fl.j=fl.k
END
END
fl.0=fl.0-1
i=i-1
END
IF i>=fl.0 THEN LEAVE i
END
Wildcard=WildBack /* Restore original Wildcard */
SAY "Removed "||FL0Back-fl.0||" entries due to wildcarding"
END
/* Now possibly check for archives...*/
DO i=1 TO fl.0
IF dirm='MULTI' THEN flcat=fl.i
ELSE flcat=thedir||fl.i
IF ExamineNames="YES" | ExamineFiles="YES" THEN DO /* Check for LhA/Lzh/pp files */
SELECT
WHEN ExamineNames="YES" & (UPPER(RIGHT(flcat,4))=".LZH" | UPPER(RIGHT(flcat,4))=".LHA") THEN DO
flcat=UnPack("LHA",flcat,thedir)
IF dirm='MULTI' THEN fl.i=thedir||flcat
ELSE fl.i=flcat
END
WHEN ExamineNames="YES" & UPPER(RIGHT(flcat,3))=".PP" THEN CALL UnPack("PP",flcat,thedir)
WHEN ExamineFiles="YES" & ExamineFile(flcat)="LHA" THEN DO
flcat=UnPack("LHA",flcat,thedir)
IF dirm='MULTI' THEN fl.i=thedir||flcat
ELSE fl.i=flcat
END
WHEN ExamineFiles="YES" & ExamineFile(flcat)="PP" THEN CALL UnPack("PP",flcat,thedir)
OTHERWISE NOP
END
END
END
/* Now sort the filelist */
IF fl.0>1 THEN DO
RG=fl.0 /* DontKnowItsName-Sortalgo,twice as fast as BubbleSort */
DO UNTIL RG=1
MAX=''
DO i=1 TO RG
IF UPPER(fl.i)>=MAX THEN DO
MAX=UPPER(fl.i)
entry=i
END
END
b=fl.RG
fl.RG=fl.entry
fl.entry=b
RG=RG-1
END
END
/* Now checking if catalogs exist in the catalogdir and ask what to do */
/* Catalogs are identified from the current basename... */
AlreadyAsked=0
OverFlag=1
CAPFL=SHOWDIR(CatDir,'File')
IF WORDS(CAPFL)>0 THEN DO
DO i=1 TO WORDS(CAPFL)
IF (SUBSTR(WORD(CAPFL,i),1,LASTPOS('.',WORD(CAPFL,i)))=catbasis) | (LEFT(WORD(CAPFL,i),LENGTH(catbasis))=catbasis & RIGHT(WORD(CAPFL,i),4)='.bak') THEN DO
/* Found existing catalog */
IF ~Arguments THEN DO
IF ~AlreadyAsked & SUBSTR(WORD(CAPFL,i),1,LASTPOS('.',WORD(CAPFL,i)))=catbasis THEN DO
OKAY2 '" Overwrite or rename'||NL||' existing catalog ?'||NL||'OK=Overwrite Cancel=Rename"'
OverFlag=rc
AlreadyAsked=1
END
IF ~OverFlag THEN ADDRESS COMMAND 'rename "'||catdir||WORD(CAPFL,i)||'" "'||catdir||WORD(CAPFL,i)||'.bak"'
END
END
END
END
IF catdir=thedir THEN DO
/* We must also delete this entry from the FileList */
DO j=1 TO fl.0
IF INDEX(fl.j,catbasis)~=0 THEN DO /* Delete entry */
IF fl.0>j THEN DO
DO k=j TO fl.0-1
l=k+1
fl.k=fl.l
END
END
fl.0=fl.0-1
END
END
END
/* The Listview for the tiling */
IF Up2Date | Arguments THEN DO
IF ~Arguments THEN DO
ListView '"Tiling for '||fl.0||' pics"' 10 ITEMS TileList
IF rc>1 THEN CALL ERR('')
PARSE VAR adpro_result '"' ERGo '"' .
END
IF ERGo~='Auto' & ERGo~='Custom' THEN PARSE VAR ERGo TWI 'x' THI .
ELSE DO
IF ERGo='Custom' THEN CALL QueryTiling
IF ERGo='Auto' THEN DO
/* Automode to fit all pics on one catalog */
TWI=0
THI=0
dum1=1
DO UNTIL TWI*THI>=fl.0
IF dum1 THEN DO
TWI=TWI+1
dum1=0
END
ELSE DO
THI=THI+1
dum1=1
END
END
END
END
END
ELSE CALL QueryTiling
/* Size of each tile in pixels */
IF AddHeader='YES' THEN PHE=PHE-HeaderSize-2
TWID=TRUNC((PWI-TWI-1)/TWI)
THEI=TRUNC((PHE-THI-1)/THI)
/* Perhaps do a custom-sorting now */
IF Sorting='CUSTOM' & Up2Date THEN DO
FLA=''
DO i=1 to fl.0
IF dirm='MULTI' THEN Dummy=fl.i
ELSE Dummy=thedir||fl.i
FString=Dummy
IF INDEX(FString,' ')~=0 THEN CALL ERR('Spaces in filenames arent allowed!')
IF VERIFY(FString,'/:','MATCH')~=0 THEN DO
IF LastPos('/',FString)=0 THEN DO
IF Index(FString,':')~=0 THEN FString=substr(FString,Index(FString,':')+1)
